home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0077_String Timing Demo.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  8KB  |  232 lines
  1.  {$A+,B-,D-,E-,F-,I+,N-,O-,R-,S-,V+}
  2.  
  3. program TestStringComp;
  4. uses
  5.   TpTimer;         (* TurboPower's public domain TpTimer unit.              *)
  6.  
  7.                    (* Run-Length-Encoded string compression.                *)
  8.   function fustRLEcomp(stIn : string) : string;
  9.   var
  10.     byCount,
  11.     byStInSize,
  12.     byStTempPos : byte;
  13.     woStInPos : word;
  14.     stTemp : string;
  15.   begin
  16.     fillchar(stTemp, sizeof(stTemp), 0);
  17.     byCount  := 1;
  18.     byStTempPos := 1;
  19.     woStInPos := 1;
  20.     byStInSize := ord(stIn[0]);
  21.     repeat
  22.       if (woStInPos < byStInSize)
  23.       and (stIn[woStInPos] = stIn[succ(woStInPos)])
  24.       and (byCount < $7F) then
  25.         inc(byCount)
  26.       else
  27.         if (byCount > 3) then
  28.           begin
  29.             stTemp[byStTempPos]       := #0;
  30.             stTemp[(byStTempPos + 1)] := chr(byCount);
  31.             stTemp[(byStTempPos + 2)] := stIn[woStInPos];
  32.             inc(stTemp[0], 3);
  33.             inc(byStTempPos, 3);
  34.             byCount := 1
  35.           end
  36.         else
  37.           begin
  38.             move(stIn[succ(woStInPos - byCount)],
  39.                  stTemp[byStTempPos], byCount);
  40.             inc(stTemp[0], byCount);
  41.             inc(byStTempPos, byCount);
  42.             byCount := 1
  43.           end;
  44.       inc(woStInPos, 1)
  45.     until (woStInPos > byStInSize);
  46.     fustRLEcomp := stTemp
  47.   end;
  48.  
  49.  
  50.                    (* Run-Length-Encoded string expansion.                  *)
  51.   function fustRLEexp(stIn : string) : string;
  52.   var
  53.     byStInSize,
  54.     byStTempPos : byte;
  55.     woStInPos : word;
  56.     stTemp : string;
  57.   begin
  58.     fillchar(stTemp, sizeof(stTemp), 0);
  59.     byStInSize := ord(stIn[0]);
  60.     byStTempPos := 1;
  61.     woStInPos := 1;
  62.     repeat
  63.       if (stIn[woStInPos] <> #0) then
  64.         begin
  65.           stTemp[byStTempPos] := stIn[woStInPos];
  66.           inc(woStInPos, 1);
  67.           inc(byStTempPos, 1);
  68.           inc(stTemp[0], 1)
  69.         end
  70.       else
  71.         begin
  72.           fillchar(stTemp[byStTempPos], ord(stIn[succ(woStInPos)]),
  73.                    stIn[(woStInPos + 2)]);
  74.           inc(byStTempPos, ord(stIn[succ(woStInPos)]));
  75.           inc(stTemp[0], ord(stIn[succ(woStInPos)]));
  76.           inc(woStInPos, 3)
  77.         end
  78.     until (woStInPos > byStInSize);
  79.     fustRLEexp := stTemp
  80.   end;
  81.  
  82.  
  83.                    (* 8 bit into 7 bit string compression.                  *)
  84.   function fustComp87(stIn : string) : string;
  85.   var
  86.     stTemp : string;
  87.     byLoop, byTempSize, byOffset : byte;
  88.   begin
  89.     if (stIn[0] < #255) then
  90.       stIn[succ(ord(stIn[0]))] := #0;
  91.     fillchar(stTemp, sizeof(stTemp), 0);
  92.     byTempSize := ord(stIn[0]) shr 3;
  93.     if ((ord(stIn[0]) mod 8) <> 0) then
  94.       inc(byTempsize, 1);
  95.     byOffset := 0;
  96.     for byLoop := 1 to byTempSize do
  97.       begin
  98.         stTemp[(byOffset * 7) + 1] :=
  99.           chr( ( (ord(stIn[(byOffset * 8) + 1]) and $7F) shl 1) +
  100.                ( (ord(stIn[(byOffset * 8) + 2]) and $40) shr 6) );
  101.         stTemp[(byOffset * 7) + 2] :=
  102.           chr( ( (ord(stIn[(byOffset * 8) + 2]) and $3F) shl 2) +
  103.                ( (ord(stIn[(byOffset * 8) + 3]) and $60) shr 5) );
  104.         stTemp[(byOffset * 7) + 3] :=
  105.           chr( ( (ord(stIn[(byOffset * 8) + 3]) and $1F) shl 3) +
  106.                ( (ord(stIn[(byOffset * 8) + 4]) and $70) shr 4) );
  107.         stTemp[(byOffset * 7) + 4] :=
  108.           chr( ( (ord(stIn[(byOffset * 8) + 4]) and $0F) shl 4) +
  109.                ( (ord(stIn[(byOffset * 8) + 5]) and $78) shr 3) );
  110.         stTemp[(byOffset * 7) + 5] :=
  111.           chr( ( (ord(stIn[(byOffset * 8) + 5]) and $07) shl 5) +
  112.                ( (ord(stIn[(byOffset * 8) + 6]) and $7C) shr 2) );
  113.         stTemp[(byOffset * 7) + 6] :=
  114.           chr( ( (ord(stIn[(byOffset * 8) + 6]) and $03) shl 6) +
  115.                ( (ord(stIn[(byOffset * 8) + 7]) and $7E) shr 1) );
  116.         if (byOffset < 31) then
  117.           stTemp[(byOffset * 7) + 7] :=
  118.             chr( ( ( ord(stIn[(byOffset * 8) + 7]) and $01) shl 7) +
  119.                  ( ord(stIn[(byOffset * 8) + 8]) and $7F) )
  120.         else
  121.           stTemp[(byOffset * 7) + 7] :=
  122.             chr( ( ord(stIn[(byOffset * 8) + 7]) and $01) shl 7);
  123.         inc(byOffset, 1)
  124.       end;
  125.     stTemp[0] := chr(((ord(stIn[0]) div 8) * 7) + (ord(stIn[0]) mod 8) );
  126.     fustComp87 := stTemp
  127.   end;
  128.  
  129.  
  130.                    (* 7 bit into 8 bit string expansion.                    *)
  131.   function fustExp78(stIn : string) : string;
  132.   var
  133.     stTemp : string;
  134.     byOffset, byTempSize, byLoop : byte;
  135.   begin
  136.     fillchar(stTemp, sizeof(stTemp), 0);
  137.     byTempSize := ord(stIn[0]) div 7;
  138.     if ((ord(stIn[0]) mod 7) <> 0)then
  139.       inc(byTempSize, 1);
  140.     byOffset := 0;
  141.     for byLoop := 1 to byTempSize do
  142.       begin
  143.         stTemp[(byOffset * 8) + 1] :=
  144.           chr( ord(stIn[(byOffset * 7) + 1]) shr 1);
  145.         stTemp[(byOffset * 8) + 2] :=
  146.           chr( ( ( ord(stIn[(byOffset * 7) + 1]) and  $01) shl 6) +
  147.                ( ( ord(stIn[(byOffset * 7) + 2]) and $FC) shr 2) );
  148.         stTemp[(byOffset * 8) + 3] :=
  149.           chr( ( ( ord(stIn[(byOffset * 7) + 2]) and $03) shl 5) +
  150.                ( ord(stIn[(byOffset * 7) + 3]) shr 3) );
  151.         stTemp[(byOffset * 8) + 4] :=
  152.           chr( ( ( ord(stIn[(byOffset * 7) + 3]) and $07) shl 4) +
  153.                ( ord(stIn[(byOffset * 7) + 4]) shr 4) );
  154.         stTemp[(byOffset * 8) + 5] :=
  155.           chr( ( ( ord(stIn[(byOffset * 7) + 4]) and $0F) shl 3) +
  156.                ( ord(stIn[(byOffset * 7) + 5]) shr 5) );
  157.         stTemp[(byOffset * 8) + 6] :=
  158.           chr( ( ( ord(stIn[(byOffset * 7) + 5]) and $1F) shl 2) +
  159.                ( ord(stIn[(byOffset * 7) + 6]) shr 6) );
  160.         stTemp[(byOffset * 8) + 7] :=
  161.           chr( ( ( ord(stIn[(byOffset * 7) + 6]) and $3F) shl 1) +
  162.                ( ord(stIn[(byOffset * 7) + 7]) shr 7) );
  163.         if (byOffset < 31) then
  164.           stTemp[(byOffset * 8) + 8] :=
  165.             chr( (ord(stIn[(byOffset * 7) + 7]) and $7F) );
  166.         inc(byOffset, 1)
  167.       end;
  168.     stTemp[0] :=
  169.       chr( ( (ord(stIn[0]) div 7) * 8) + (ord(stIn[0]) mod 7) );
  170.     if (stTemp[ord(stTemp[0])] = #0) then
  171.       dec(stTemp[0], 1);
  172.     fustExp78 := stTemp
  173.   end;
  174.  
  175.  
  176. var
  177.   loStart, loStop : longint;
  178.  
  179.   stMy1,
  180.   stMy2,
  181.   stMy3 : string;
  182.  
  183.                    (* Main program execution block.                         *)
  184. BEGIN
  185.  
  186.                    (* Test string 1.                                        *)
  187.   stMy1 := '12345678901111111111123456789022222222221234567890' +
  188.            '33333333331234567890444444444412345678905555555555' +
  189.            '12345678906666666666123456789077777777771234567890' +
  190.            '88888888881234567890999999999912345678900000000000' +
  191.            '1234567890AAAAAAAAAA1234567890BBBBBBBBBB1234567890' +
  192.            'CCCCC';
  193.  
  194.                    (* Test string 2.                                        *)
  195. { stMy1 := '12345678901234567890123456789012345678901234567890' +
  196.            '12345678901234567890123456789012345678901234567890' +
  197.            '12345678901234567890123456789012345678901234567890' +
  198.            '12345678901234567890123456789012345678901234567890' +
  199.            '12345678901234567890123456789012345678901234567890' +
  200.            '12345'; }
  201.  
  202.                    (* Test string 3.                                        *)
  203. { stMy1 := '11111111111111111111111111111111111111111111111111' +
  204.            '11111111111111111111111111111111111111111111111111' +
  205.            '11111111111111111111111111111111111111111111111111' +
  206.            '11111111111111111111111111111111111111111111111111' +
  207.            '11111111111111111111111111111111111111111111111111' +
  208.            '11111'; }
  209.  
  210.   loStart := ReadTimer;
  211.   stMy2 := fustComp87(fustRLEcomp(stMy1));
  212.   loStop := ReadTimer;
  213.   writeln(' Time to compress = ', ElapsedTimeString(loStart, loStop), ' ms');
  214.   loStart := ReadTimer;
  215.   stMy3 := fustRLEexp(fustExp78(stMy2));
  216.   loStop := ReadTimer;
  217.   writeln(' Time to expand   = ', ElapsedTimeString(loStart, loStop), ' ms');
  218.   writeln;
  219.   writeln(stMy1);
  220.   writeln;
  221.   writeln(stMy2);
  222.   writeln;
  223.   writeln(stMy3);
  224.   writeln;
  225.   if (stMy1 <> stMy3) then
  226.     writeln(' Conversion Error')
  227.   else
  228.     writeln(' Conversion Match')
  229. END.
  230.  
  231.  
  232.